Push the knit button!

library(tidyverse) # contains ggplot2, dplyr, tidyr, etc
library(leaflet)
library(lubridate)
library(plotly)
library(gganimate)
library(viridis)
library(ggthemes)

tuberculosis dataset

tb <- read_csv(here::here("data/TB_notifications_2020-07-01.csv")) %>% 
  dplyr::select(country, iso3, year, new_sp_m04:new_sp_fu) %>%
  pivot_longer(cols=new_sp_m04:new_sp_fu, names_to="sexage", values_to="count") %>%
  mutate(sexage = str_replace(sexage, "new_sp_", "")) %>%
  mutate(sex=substr(sexage, 1, 1), 
         age=substr(sexage, 2, length(sexage))) %>%
  dplyr::select(-sexage) %>%
  filter(!(age %in% c("04", "014", "514", "u"))) %>%
  filter(year > 1996, year < 2013) %>%
  mutate(age_group = factor(age, 
                            labels = c("15-24", "25-34", "35-44", 
                                       "45-54", "55-64", "65-"))) %>%
  dplyr::select(country, year, age_group, sex, count)

# Filter Australia
tb_oz <- tb %>% 
  filter(country == "Australia") 

# Fix names
tb_fixed <- tb %>% 
  mutate(region=recode(country, 
                       "United States of America"="USA", 
                       "United Kingdom of Great Britain and Northern Ireland"="UK",
                       "Russian Federation"="Russia",
                       "Viet Nam"="Vietnam",
                       "Venezuela (Bolivarian Republic of)"="Venezuela",
                       "Bolivia (Plurinational State of)"="Bolivia",
                       "Czechia"="Czech Republic",
                       "Iran (Islamic Republic of)"="Iran",
                       "Iran (Islamic Republic of)"="Laos",
                       "Democratic People's Republic of Korea"="North Korea",
                       "Republic of Korea"="South Korea",
                       "United Republic of Tanzania"="Tanzania",
                       "Congo"="Republic of Congo"))

# Aggregate by year
tb_yearly <- tb_fixed %>%
group_by(year, region) %>%
summarise(count = sum(count))

platypus dataset

load(here::here("data/platypus.rda"))
platypus <- platypus %>%
  rename(eventDate = `Event Date - parsed`) %>%
  filter(!is.na(Latitude), !is.na(Longitude), !is.na(eventDate)) %>%
  filter(year(eventDate) > 2018)

Exercise 1.1: Leaflet with different colour

platypus %>%
  leaflet() %>%
  addTiles() %>%
  addCircleMarkers(
    radius=1, opacity = 0.5, color = "purple", label = ~eventDate,
    lat = ~Latitude, lng = ~Longitude)

Exercise 1.2: Add colour to plotly highlighting

Remember this code:

tb_action <- highlight_key(tb_oz, ~age_group)

p2 <- ggplot(tb_action, aes(x=year, y=count)) +
  geom_line(aes(group=age_group)) +
  geom_smooth() + 
  facet_wrap(~sex)  

gg <- ggplotly(p2, height = 300, width = 600) %>%
   layout(title = "Click on a line to highlight an age group")

highlight(gg)

Use this plot as the base, and check highlighting still works

p2 <- ggplot(tb_oz, aes(x=year, y=count)) +
  geom_line(aes(colour=age_group, group=age_group)) +
  facet_wrap(~sex)  
p2

Exercise 1.3: Animate a map

This is a bit slow to generate, but give it a go!

tb_yr_map <- world_map %>% left_join(tb_yearly) %>%
  filter(year > 2009) %>%
  mutate(count = log(count + 1))
ggplot(tb_yr_map, aes(x=long, y=lat, group=group)) + 
    geom_polygon(aes(fill=count), #<<
             color="grey70", size=0.1, na.rm=TRUE) +  #<<
    expand_limits(x = world_map$long*1.1, y = world_map$lat*1.1) +
    scale_fill_viridis("Count (log)") +
    theme_map() +
    transition_states(year, 3, 1) + #<<
    labs(title = "{closest_state}")